type 'a list = LNil_ | LCons_ of 'a Lazy.t * 'a list Lazy.t

(* List operations *)

let length =
  let rec length_aux len (lazy l) =
    match l with
      | LNil_ -> len
      | LCons_ (_, tl) -> length_aux (len + 1) tl
  in
    lazy (fun l -> length_aux 0 l)

let hd =
  let hd_aux (lazy l) =
    match l with
      | LNil_ -> failwith "hd"
      | LCons_ (hd, _) -> Lazy.force hd
  in
    lazy hd_aux

let tl =
  let tl_aux (lazy l) =
    match l with
      | LNil_ -> failwith "tl"
      | LCons_ (_, tl) -> Lazy.force tl
  in
    lazy tl_aux

let nth =
  let rec nth' l n =
    match Lazy.force l with
      | LNil_ -> failwith "nth"
      | LCons_ (a, l) -> if n = 0 then Lazy.force a else nth' l (n - 1)
  in
  let nth_aux l k =
    let n = Lazy.force k in
      if n < 0 then invalid_arg "List.nth" else nth' l n
  in
    lazy nth_aux

let append =
  let rec append_aux l1 l2 =
    match Lazy.force l1 with
      | LNil_ -> Lazy.force l2
      | LCons_ (hd, tl) -> LCons_ (hd, lazy (append_aux tl l2))
  in
    lazy append_aux

let rev_append =
  let rec rev_append_aux l1 l2 =
    match Lazy.force l1 with
      | LNil_ -> Lazy.force l2
      | LCons_ (a, l) -> rev_append_aux l (lazy (LCons_ (a, l2)))
  in
    lazy rev_append_aux

let rev = lazy (fun l -> (Lazy.force rev_append) l (lazy LNil_))

let flatten =
  let rec flatten_aux l =
    match Lazy.force l with
      | LNil_ -> LNil_
      | LCons_ (l, r) -> (Lazy.force append) l (lazy (flatten_aux r))
  in
    lazy flatten_aux

let concat = flatten

let map =
  let map_aux f l =
    let rec map' l =
      match Lazy.force l with
	| LNil_ -> LNil_
	| LCons_ (a, l) -> LCons_ (lazy ((Lazy.force f) a), lazy (map' l))
    in
      map' l
  in
    lazy map_aux

let rev_map =
  let rev_map_aux f l =
    let rec rev_map' res l =
      match Lazy.force l with
	| LNil_ -> res
	| LCons_ (a, l) ->
	    rev_map' (LCons_ (lazy ((Lazy.force f) a), lazy res)) l
    in
      rev_map' LNil_ l
  in
    lazy rev_map_aux

let iter =
  let iter_aux f l =
    let rec iter' l =
      match Lazy.force l with
	| LNil_ -> ()
	| LCons_ (a, l) -> (Lazy.force f) a; iter' l
    in
      iter' l
  in
    lazy iter_aux

let fold_left =
  let fold_left_aux f init l =
    let rec fold_left' accu l =
      match Lazy.force l with
	| LNil_ -> Lazy.force accu
	| LCons_ (a, l) -> fold_left' (lazy ((Lazy.force f) accu a)) l
    in
      fold_left' init l
  in
    lazy fold_left_aux

let fold_right =
  let fold_right_aux f l init =
    let rec fold_right' l =
      match Lazy.force l with
	| LNil_ -> Lazy.force init
	| LCons_ (a, l) -> (Lazy.force f) a (lazy (fold_right' l))
    in
      fold_right' l
  in
    lazy fold_right_aux

let map2 =
  let map2_aux f l1 l2 =
    let rec map2' l1 l2 =
      match (Lazy.force l1, Lazy.force l2) with
	| (LNil_, LNil_) -> LNil_
	| (LCons_ (a1, l1), LCons_ (a2, l2)) ->
	    LCons_ (lazy ((Lazy.force f) a1 a2), lazy (map2' l1 l2))
	| (_, _) -> invalid_arg "List.map2"
    in
      map2' l1 l2
  in
    lazy map2_aux

let rev_map2 =
  let rev_map2_aux f l1 l2 =
    let rec rev_map2' accu l1 l2 =
      match (Lazy.force l1, Lazy.force l2) with
	| (LNil_, LNil_) -> accu
	| (LCons_ (a1, l1), LCons_ (a2, l2)) ->
	    rev_map2' (LCons_ (lazy ((Lazy.force f) a1 a2), lazy accu)) l1 l2
	| (_, _) -> invalid_arg "List.rev_map2"
    in
      rev_map2' LNil_ l1 l2
  in
    lazy rev_map2_aux
;;

let iter2 =
  let iter2_aux f l1 l2 =
    let rec iter2' l1 l2 =
      match (Lazy.force l1, Lazy.force l2) with
	| (LNil_, LNil_) -> ()
	| (LCons_ (a1, l1), LCons_ (a2, l2)) ->
	    (Lazy.force f) a1 a2; iter2' l1 l2
	| (_, _) -> invalid_arg "List.iter2"
    in
      iter2' l1 l2
  in
    lazy iter2_aux

let fold_left2 =
  let fold_left2_aux f init l1 l2 =
    let rec fold_left2' accu l1 l2 =
      match (Lazy.force l1, Lazy.force l2) with
	| (LNil_, LNil_) -> Lazy.force accu
	| (LCons_ (a1, l1), LCons_ (a2, l2)) ->
	    fold_left2' (lazy ((Lazy.force f) accu a1 a2)) l1 l2
	| (_, _) -> invalid_arg "List.fold_left2"
    in
      fold_left2' init l1 l2
  in
    lazy fold_left2_aux
      
let fold_right2 =
  let fold_right2_aux f l1 l2 init =
    let rec fold_right2' l1 l2 =
      match (Lazy.force l1, Lazy.force l2) with
	| (LNil_, LNil_) -> Lazy.force init
	| (LCons_ (a1, l1), LCons_ (a2, l2)) ->
	    (Lazy.force f) a1 a2 (lazy (fold_right2' l1 l2))
	| (_, _) -> invalid_arg "List.fold_right2"
    in
      fold_right2' l1 l2
  in
    lazy fold_right2_aux


let for_all =
  let for_all_aux p l =
    let rec for_all' l =
      match Lazy.force l with
	| LNil_ -> true
	| LCons_ (a, l) -> (Lazy.force p) a && for_all' l
    in
      for_all' l
  in
    lazy for_all_aux

let exists =
  let exists_aux p l =
    let rec exists' l =
      match Lazy.force l with
	| LNil_ -> false
	| LCons_ (a, l) -> (Lazy.force p) a || exists' l
    in
      exists' l
  in
    lazy exists_aux

let for_all2 =
  let for_all2_aux p l1 l2 =
    let rec for_all2' l1 l2 =
      match (Lazy.force l1, Lazy.force l2) with
	| (LNil_, LNil_) -> true
	| (LCons_ (a1, l1), LCons_ (a2, l2)) ->
	    (Lazy.force p) a1 a2 && for_all2' l1 l2
	| (_, _) -> invalid_arg "List.for_all2"
    in
      for_all2' l1 l2
  in
    lazy for_all2_aux

let exists2 =
  let exists2_aux p l1 l2 =
    let rec exists2' l1 l2 =
      match (Lazy.force l1, Lazy.force l2) with
	| (LNil_, LNil_) -> false
	| (LCons_ (a1, l1), LCons_ (a2, l2)) ->
	    (Lazy.force p) a1 a2 || exists2' l1 l2
	| (_, _) -> invalid_arg "List.exists2"
    in
      exists2' l1 l2
  in
    lazy exists2_aux

let mem =
  let mem_aux x l =
    let rec mem' l =
      match Lazy.force l with
	| LNil_ -> false
	| LCons_ (a, l) -> compare (Lazy.force a) (Lazy.force x) = 0 || mem' l
    in
      mem' l
  in
    lazy mem_aux

let memq =
  let memq_aux x l =
    let rec memq' l =
      match Lazy.force l with
	| LNil_ -> false
	| LCons_ (a, l) -> (Lazy.force a) == (Lazy.force x) || memq' l
    in
      memq' l
  in
    lazy memq_aux

let assoc =
  let assoc_aux x l =
    let rec assoc' l =
      match Lazy.force l with
	| LNil_ -> raise Not_found
	| LCons_ (pair, l) ->
	    let (a, b) = Lazy.force pair in
	      if compare (Lazy.force a) (Lazy.force x) = 0
	      then Lazy.force b else assoc' l
    in
      assoc' l
  in
    lazy assoc_aux

let assq =
  let assq_aux x l =
    let rec assq' l =
      match Lazy.force l with
	| LNil_ -> raise Not_found
	| LCons_ (pair, l) ->
	    let (a, b) = Lazy.force pair in
	      if Lazy.force a == Lazy.force x then Lazy.force b else assq' l
    in
      assq' l
  in
    lazy assq_aux
      
let mem_assoc =
  let mem_assoc_aux x l =
    let rec mem_assoc' l =
      match Lazy.force l with
	| LNil_ -> false
	| LCons_ (pair, l) ->
	    let (a, _) = Lazy.force pair in
	      compare (Lazy.force a) (Lazy.force x) = 0 || mem_assoc' l
    in
      mem_assoc' l
  in
    lazy mem_assoc_aux

let mem_assq =
  let mem_assq_aux x l =
    let rec mem_assq' l =
      match Lazy.force l with
	| LNil_ -> false
	| LCons_ (pair, l) ->
	    let (a, _) = Lazy.force pair in
	      Lazy.force a == Lazy.force x || mem_assq' l
    in
      mem_assq' l
  in
    lazy mem_assq_aux

let remove_assoc =
  let remove_assoc_aux x l =
    let rec remove_assoc' l =
      match Lazy.force l with
	| LNil_ -> LNil_
	| LCons_ (pair, l) ->
	    let (a, _) = Lazy.force pair in
	      if compare (Lazy.force a) (Lazy.force x) = 0
	      then Lazy.force l
	      else LCons_ (pair, lazy (remove_assoc' l))
    in
      remove_assoc' l
  in
    lazy remove_assoc_aux

let remove_assq =
  let remove_assq_aux x l =
    let rec remove_assq' l =
      match Lazy.force l with
	| LNil_ -> LNil_
	| LCons_ (pair, l) ->
	    let (a, _) = Lazy.force pair in
	      if Lazy.force a == Lazy.force x
	      then Lazy.force l else
		LCons_ (pair, lazy (remove_assq' l))
    in
      remove_assq' l
  in
    lazy remove_assq_aux

let find =
  let find_aux p l =
    let rec find' l =
      match Lazy.force l with
	| LNil_ -> raise Not_found
	| LCons_ (x, l) -> if (Lazy.force p) x then Lazy.force x else find' l
    in
      find' l
  in
    lazy find_aux

let find_all =
  let find_all_aux p l =
    let rec find_all' accu l =
      match Lazy.force l with
	| LNil_ -> (Lazy.force rev) accu
	| LCons_ (x, l) ->
	    if (Lazy.force p) x then find_all' (lazy (LCons_ (x, accu))) l
	    else find_all' accu l
    in
      find_all' (lazy LNil_) l
  in
    lazy find_all_aux

let filter = find_all

let partition =
  let partition_aux p l =
    let rec partition' yes no l =
      match Lazy.force l with
	| LNil_ -> (lazy ((Lazy.force rev) yes), lazy ((Lazy.force rev) no))
	| LCons_ (x, l) ->
	    if (Lazy.force p) x then partition' (lazy (LCons_ (x, yes))) no l
	    else partition' yes (lazy (LCons_ (x, no))) l
    in
      partition' (lazy LNil_) (lazy LNil_) l
  in
    lazy partition_aux

let split =
  let rec split_aux l =
    match Lazy.force l with
      | LNil_ -> (lazy LNil_, lazy LNil_)
      | LCons_ (pair, l) ->
	  let (x, y) = Lazy.force pair in
	  let (rx, ry) = split_aux l in
	    (lazy (LCons_ (x, rx)), lazy (LCons_ (y, ry)))
  in
    lazy split_aux

let combine =
  let rec combine_aux l1 l2 =
    match (Lazy.force l1, Lazy.force l2) with
      | (LNil_, LNil_) -> LNil_
      | (LCons_ (a1, l1), LCons_ (a2, l2)) ->
	  LCons_ (lazy (a1, a2), lazy (combine_aux l1 l2))
      | (_, _) -> invalid_arg "List.combine"
  in
    lazy combine_aux

(** sorting *)

let merge =
  let merge_aux cmp l1 l2 =
    let rec merge' l1 l2 =
      match (Lazy.force l1, Lazy.force l2) with
	| (LNil_, l2) -> l2
	| (l1, LNil_) -> l1
	| (LCons_ (h1, t1), (LCons_ (h2, t2))) ->
            if ((Lazy.force cmp) h1 h2) <= 0
            then LCons_ (h1, (lazy (merge' t1 l2)))
            else LCons_ (h2, (lazy (merge' l1 t2)))
    in
      merge' l1 l2
  in
    lazy merge_aux
;;

let stable_sort =
  let stable_sort_aux cmp l =
    if Lazy.force l = LNil_ then LNil_ else
      let fcmp = Lazy.force cmp in
      let cmp x y = fcmp (lazy x) (lazy y) in
      let rec to_list acc l =
	match Lazy.force l with
	  | LNil_ -> acc
	  | LCons_ (a, l) -> to_list (Lazy.force a :: acc) l
      in
      let rec of_list l =
	match l with
	  | [] -> LNil_
	  | a :: l -> LCons_ (lazy a, lazy (of_list l))
      in
	of_list (List.sort cmp (to_list [] l))
  in
    lazy stable_sort_aux

let sort = stable_sort;;

let fast_sort = stable_sort;;
